VERSION 5.00
Begin VB.Form frmAddClass 
   BorderStyle     =   4  'Fixed ToolWindow
   Caption         =   "Add Classifications"
   ClientHeight    =   7170
   ClientLeft      =   45
   ClientTop       =   615
   ClientWidth     =   8385
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MDIChild        =   -1  'True
   MinButton       =   0   'False
   ScaleHeight     =   7170
   ScaleWidth      =   8385
   ShowInTaskbar   =   0   'False
   Begin VB.Frame Frame1 
      Height          =   6615
      Left            =   360
      TabIndex        =   0
      Top             =   240
      Width           =   7695
      Begin VB.CommandButton cmdAddTo 
         Caption         =   "<="
         Height          =   495
         Left            =   3000
         TabIndex        =   5
         Top             =   3000
         Width           =   615
      End
      Begin VB.TextBox txtLv2 
         Height          =   5055
         Left            =   3720
         MultiLine       =   -1  'True
         ScrollBars      =   3  'Both
         TabIndex        =   4
         Top             =   1200
         Width           =   3855
      End
      Begin VB.ListBox lstLv2 
         Height          =   5130
         Left            =   600
         TabIndex        =   2
         Top             =   1200
         Width           =   2295
      End
      Begin VB.ComboBox cmbLv1 
         Height          =   315
         Left            =   600
         TabIndex        =   1
         Text            =   "Combo1"
         Top             =   600
         Width           =   2295
      End
      Begin VB.Label Label1 
         Caption         =   "Add Classifications:"
         Height          =   375
         Left            =   3600
         TabIndex        =   3
         Top             =   600
         Width           =   2775
      End
   End
   Begin VB.Menu mnuPop 
      Caption         =   "PopMenu"
      Begin VB.Menu EditCt 
         Caption         =   "Edit"
      End
      Begin VB.Menu DelCt 
         Caption         =   "Delete"
      End
   End
End
Attribute VB_Name = "frmAddClass"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim cn As New ADODB.Connection
Dim rs As New ADODB.Recordset

Dim Lv1Arr(0 To 99) As Integer
Dim Lv2Arr(0 To SUB_CLASS) As Integer

Private Sub CloseRecordSet()
On Error GoTo NoErr
        rs.Close
NoErr:
End Sub

Private Function ResetArr(ByVal lv As Integer)
    Dim i, b As Integer
    If lv = 1 Then
        b = 99
    Else
        b = SUB_CLASS
    End If
    
    For i = 0 To b
        If lv = 1 Then
            Lv1Arr(i) = 0
        Else
            Lv2Arr(i) = 0
        End If
    Next i
End Function

Private Sub cmbLv1_Click()
    Dim id, i As Integer
    Dim sql As String
    
    If cmbLv1.ListIndex = 0 Then
        ShowAllSub
        Exit Sub
    End If
    
    ResetArr 2
    
    If cmbLv1.ListIndex = -1 Then
        MsgBox "You haven't picked up any thing!", vbOKOnly, SOFT_TITLE
    Else
        lstLv2.Clear
        id = Lv1Arr(cmbLv1.ListIndex)
        sql = "SELECT `Sort_ID`, `Sort_Name` FROM  `cs_sort` Where bMain = 0 AND Sort_ID LIKE  '" & Trim(str(id)) & "___' "
        CloseRecordSet
        OperateDatabase rs, cn, sql
        i = 0
        While Not rs.EOF
            lstLv2.AddItem rs.Fields(1).value
            Lv2Arr(i) = rs.Fields(0).value
            rs.MoveNext
            i = i + 1
        Wend
    End If
End Sub



Private Sub cmdAddTo_Click()
    Dim i, igArr2, igArr2Number As Integer
    Dim strLv2 As String
    Dim strLv2Arr(0 To SUB_CLASS) As String
    
    Dim sql As String
    
    igArr2 = Find1stRecord()
    If igArr2 = 0 Then
        If cmbLv1.ListIndex = 0 Then
            MsgBox "Please don't insert records to this classification!", vbOKOnly, SOFT_TITLE
            Exit Sub
        End If
        'if no sub classification, the ID should be generated separately
        igArr2Number = val(Lv1Arr(cmbLv1.ListIndex) & "001")
    Else
        igArr2Number = FindLargest
    End If
    
    strLv2 = Trim(txtLv2.Text)
    'get all sub classifications
    Call ParseString(strLv2, strLv2Arr)
    For i = 0 To SUB_CLASS
        If strLv2Arr(i) = "" Then
            Exit For
        Else
            lstLv2.AddItem strLv2Arr(i)
            igArr2Number = igArr2Number + 1
            Lv2Arr(igArr2) = igArr2Number
            strLv2Arr(i) = ""
            igArr2 = igArr2 + 1
        End If
    Next i
    txtLv2.Text = ""
    
    'save all records to database
    'DELETE FROM `cs_sort` WHERE 1
    sql = "delete from `cs_sort` where `Sort_ID` like '" & Lv1Arr(cmbLv1.ListIndex) & "___'"
    CloseRecordSet
    OperateDatabase rs, cn, sql
    
    'insert all records from Lv2Arr
    i = 0
    While Lv2Arr(i) <> 0
        'INSERT INTO `cs_sort`(`ID`, `Sort_ID`, `Sort_Name`, `Sort_Src`, `des`, `bMain`, `img`) VALUES ([value-1],[value-2],[value-3],[value-4],[value-5],[value-6],[value-7])
        sql = "insert into `cs_sort`(`Sort_ID`, `Sort_Name`, `Sort_Src`, `bMain`) VALUES (" & Lv2Arr(i) & ",'" & lstLv2.List(i) & "', 0, 0 )"
        CloseRecordSet
        OperateDatabase rs, cn, sql
        i = i + 1
    Wend
    MsgBox "Sub classifications added!", vbOKOnly, SOFT_TITLE
End Sub

Private Function FindLargest() As Integer
    Dim i, iMax As Integer
    i = 0
    iMax = 0
    While Lv2Arr(i) <> 0
        If iMax < Lv2Arr(i) Then
            iMax = Lv2Arr(i)
        End If
        i = i + 1
    Wend
    FindLargest = iMax
End Function

Private Function Find1stRecord() As Integer
    Dim i As Integer
    i = 0
    While Lv2Arr(i) <> 0
        i = i + 1
    Wend
    Find1stRecord = i
End Function

Private Function ParseString(ByVal strLv2 As String, ByRef strLv2Arr() As String)
    Dim i, iIndex As Integer
    Dim tmpStr As String
    iIndex = 0
    
    If Right(strLv2, 2) <> vbCrLf Then
        strLv2 = strLv2 & vbCrLf
    End If
    
    For i = 1 To Len(strLv2) - 1
        If Mid(strLv2, i, 2) = vbCrLf Then
            i = i + 1
            strLv2Arr(iIndex) = tmpStr
            tmpStr = ""
            iIndex = iIndex + 1
        Else
            tmpStr = tmpStr & Mid(strLv2, i, 1)
        End If
    Next i
End Function


Private Sub DelCt_Click()
    Dim sql As String
    If cmbLv1.ListIndex = 0 Then
        MsgBox "Can't support this operation!", vbOKOnly, SOFT_TITLE
        Exit Sub
    End If
    
    If lstLv2.ListIndex = -1 Then
        MsgBox "Please choose one record!", vbOKOnly, SOFT_TITLE
        Exit Sub
    Else
        'DELETE FROM `cs_sort` WHERE 1
        sql = "DELETE FROM `cs_sort` WHERE `Sort_ID`=" & Lv2Arr(lstLv2.ListIndex)
        CloseRecordSet
        OperateDatabase rs, cn, sql
        Call DeleteOneRecord(lstLv2.ListIndex)
        lstLv2.RemoveItem lstLv2.ListIndex
        MsgBox "Record deleted!", vbOKOnly, SOFT_TITLE
    End If
End Sub

Private Sub DeleteOneRecord(ByVal iIndex As Integer)
    Dim i As Integer
    For i = iIndex To SUB_CLASS
        If Lv2Arr(i) = 0 Then
            Exit For
        Else
            Lv2Arr(i) = Lv2Arr(i + 1)
        End If
    Next i
End Sub

Private Sub EditCt_Click()
    Dim tmpStr As String
    Dim bSave As Boolean
    Dim sql As String
    Dim i As Integer
    If cmbLv1.ListIndex = 0 Then
        MsgBox "Can't support this operation!", vbOKOnly, SOFT_TITLE
        Exit Sub
    End If
    
    bSave = False
    If lstLv2.ListIndex = -1 Then
        MsgBox "Please choose one record!", vbOKOnly, SOFT_TITLE
        Exit Sub
    Else
        tmpStr = InputBox("Please enter the new name:", SOFT_TITLE, lstLv2.List(lstLv2.ListIndex))
        If tmpStr <> "" Then
            lstLv2.List(lstLv2.ListIndex) = tmpStr
            bSave = True
        End If
    End If
    
    If bSave Then
        'just need update all records
        'UPDATE `cs_sort` SET `Sort_ID`=[value-1],`Sort_Name`=[value-2],`Sort_Src`=[value-3],`des`=[value-4],`bMain`=[value-5],`img`=[value-6] WHERE 1
        i = 0
        While Lv2Arr(i) <> 0
            sql = "UPDATE `cs_sort` SET `Sort_Name`='" & lstLv2.List(i) & "' where `Sort_ID`=" & Lv2Arr(i)
            i = i + 1
            CloseRecordSet
            OperateDatabase rs, cn, sql
        'Debug.Print sql
        
        Wend
    End If
End Sub

Private Sub Form_Load()
    Dim sql As String
    Dim i As Integer
    Call Cn2Oversea(cn)
    sql = "select Sort_ID, Sort_Name from cs_sort where bMain=1"
    CloseRecordSet
    ResetArr 1
    ResetArr 2
    
    OperateDatabase rs, cn, sql
    While Not rs.EOF
        cmbLv1.AddItem rs.Fields(1).value
        Lv1Arr(i) = rs.Fields(0).value
        i = i + 1
        rs.MoveNext
    Wend
    
    cmbLv1.ListIndex = 0
    ShowAllSub
End Sub

Private Sub ShowAllSub()
    Dim sql As String
    sql = "select Sort_Name from cs_sort where bMain=0"
    CloseRecordSet
    OperateDatabase rs, cn, sql
    While Not rs.EOF
        lstLv2.AddItem rs.Fields(0).value
        rs.MoveNext
    Wend
End Sub
    
Private Sub s_Click()

End Sub

Private Sub Form_Unload(Cancel As Integer)
    customer.WindowState = 2
    customer.Show
    cn.Close
End Sub

Private Sub lstLv2_DblClick()
    EditCt_Click
End Sub

Private Sub lstLv2_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If Button = vbKeyRButton Then
        PopupMenu mnuPop
    End If
End Sub

